<%
Class FastAsp_Excel
    Private m_Excel      'Excel对象
    Private m_Book       '工作簿
    Private m_Sheet      '工作表
    Private m_Error      '错误信息
    Private m_ExcelType  'Excel组件类型
    
    Private Sub Class_Initialize()
        '尝试创建Excel组件
        On Error Resume Next
        Set m_Excel = Server.CreateObject("Excel.Application")
        If Err.Number = 0 Then
            m_ExcelType = "Excel"
        Else
            Set m_Excel = Server.CreateObject("ET.Application")
            If Err.Number = 0 Then
                m_ExcelType = "ET"
            Else
                m_Error = "未安装Excel组件"
            End If
        End If
        On Error Goto 0
    End Sub
    
    '打开Excel文件
    Public Function Open(byval file)
        If m_Error <> "" Then
            Set Open = Nothing
            Exit Function
        End If
        
        On Error Resume Next
        Set m_Book = m_Excel.Workbooks.Open(Server.MapPath(file))
        If Err.Number <> 0 Then
            m_Error = "打开Excel文件失败: " & Err.Description
            Set Open = Nothing
            Exit Function
        End If
        Set m_Sheet = m_Book.ActiveSheet
        On Error Goto 0
        Set Open = Me
    End Function
    
    '创建新Excel文件
    Public Function Create()
        If m_Error <> "" Then
            Set Create = Nothing
            Exit Function
        End If
        
        On Error Resume Next
        Set m_Book = m_Excel.Workbooks.Add()
        If Err.Number <> 0 Then
            m_Error = "创建Excel文件失败: " & Err.Description
            Set Create = Nothing
            Exit Function
        End If
        Set m_Sheet = m_Book.ActiveSheet
        On Error Goto 0
        Set Create = Me
    End Function
    
    '选择工作表
    Public Function Sheet(byval index)
        If m_Error <> "" Then Exit Function
        
        On Error Resume Next
        If IsNumeric(index) Then
            Set m_Sheet = m_Book.Sheets(CInt(index))
        Else
            Set m_Sheet = m_Book.Sheets(index)
        End If
        If Err.Number <> 0 Then
            m_Error = "选择工作表失败: " & Err.Description
        End If
        On Error Goto 0
        Set Sheet = Me
    End Function
    
    '读取单元格
    Public Function [Get](byval cell)
        If m_Error <> "" Then Exit Function
        
        On Error Resume Next
        [Get] = m_Sheet.Range(cell).Value
        If Err.Number <> 0 Then
            m_Error = "读取单元格失败: " & Err.Description
            [Get] = Empty
        End If
        On Error Goto 0
    End Function
    
    '写入单元格
    Public Function [Set](byval cell, byval value)
        If m_Error <> "" Then Exit Function
        
        On Error Resume Next
        m_Sheet.Range(cell).Value = value
        If Err.Number <> 0 Then
            m_Error = "写入单元格失败: " & Err.Description
        End If
        On Error Goto 0
        Set [Set] = Me
    End Function
    
    '读取区域
    Public Function GetRange(byval range_)
        If m_Error <> "" Then Exit Function
        
        On Error Resume Next
        Dim data : data = m_Sheet.Range(range_).Value
        If Err.Number <> 0 Then
            m_Error = "读取区域失败: " & Err.Description
            Set GetRange = Nothing
            Exit Function
        End If
        
        '转换为二维数组
        If Not IsArray(data) Then
            ReDim arr(0, 0)
            arr(0, 0) = data
            Set GetRange = arr
        Else
            Set GetRange = data
        End If
        On Error Goto 0
    End Function
    
    '写入区域
    Public Function SetRange(byval range_, byval data)
        If m_Error <> "" Then Exit Function
        
        On Error Resume Next
        m_Sheet.Range(range_).Value = data
        If Err.Number <> 0 Then
            m_Error = "写入区域失败: " & Err.Description
        End If
        On Error Goto 0
        Set SetRange = Me
    End Function
    
    '保存Excel文件
    Public Function Save(byval file)
        If m_Error <> "" Then Exit Function
        
        On Error Resume Next
        '创建目录
        CreateFolder Server.MapPath(GetFolderPath(file))
        
        '保存文件
        m_Book.SaveAs Server.MapPath(file)
        If Err.Number <> 0 Then
            m_Error = "保存Excel文件失败: " & Err.Description
        End If
        On Error Goto 0
        Set Save = Me
    End Function
    
    '关闭Excel文件
    Public Sub Close()
        If m_Book Is Nothing Then Exit Sub
        
        On Error Resume Next
        m_Book.Close False
        Set m_Book = Nothing
        Set m_Sheet = Nothing
        On Error Goto 0
    End Sub
    
    '获取错误信息
    Public Property Get Error_()
        Error_ = m_Error
    End Property
    
    '获取文件夹路径
    Private Function GetFolderPath(byval file)
        GetFolderPath = Left(file, InStrRev(file, "/"))
    End Function
    
    '创建文件夹
    Private Sub CreateFolder(byval path)
        Dim fso : Set fso = Server.CreateObject("Scripting.FileSystemObject")
        If Not fso.FolderExists(path) Then
            CreateFolder fso.GetParentFolderName(path)
            fso.CreateFolder path
        End If
        Set fso = Nothing
    End Sub
    
    Private Sub Class_Terminate()
        Close()
        If Not m_Excel Is Nothing Then
            m_Excel.Quit
            Set m_Excel = Nothing
        End If
    End Sub
End Class
%> 